---
title: |
  Replication material: Schulte-Cloos & Leininger 'Electoral Mobilization, Political Disaffection, and the Rise of the Populist Right' in: Party Politics, doi: 10.1177/1354068820985186
author: |
  Julia Schulte-Cloos
date: |
  `r lubridate::today()`
output:
  bookdown::html_document2:
    theme: cosmo
    highlight: textmate
    toc: yes
    toc_float:
      collapsed: no
      smooth_scroll: no
    number_sections: yes
    code_folding: hide
    toc_depth: 1 
link-citations: true
---


```{r setup}

# install.packages("pacman")

pacman::p_load(
  bookdown,
  ggplot2,
  knitr,
  tidyverse,
  tidymodels,
  here,
  lubridate,
  modelsummary,
  showtext,
  fuzzyjoin,
  tictoc,
  kableExtra,
  colorspace,
  ggeffects,
  png,
  patchwork
)


opts_chunk$set(
  cache = FALSE,
  echo = TRUE,
  highlight = TRUE,
  out.width = "90%",
  message = FALSE,
  warning = FALSE,
  comment = NA,
  # figure options
  fig.retina = 5,
  fig.path = "figs/fig",
  fig.showtext = TRUE
)


# runif(1,0, 10^8) #34281505
set.seed(34281505)
```


```{r ggplot-options}

showtext_auto()

# add a font from google fonts
font_add_google(
  name = "Fira Sans",
  family = "Fira Sans"
)


theme_custom <- function(base_size = 22,
                         base_family = "Fira Sans") {
  half_line <- base_size / 2
  theme_minimal(base_size = base_size, 
                base_family = base_family) %+replace%
    theme(
      # change some theme options
      plot.title = element_text(
        color = "black",
        hjust = 0.5,
        size = rel(1),
        margin = margin(b = half_line)
      ),
      plot.subtitle = element_text(
        color = "black",
        hjust = 0.5,
        size = rel(0.75),
        margin = margin(b = half_line)
      ),
      plot.background = element_rect(
        fill = "white",
        color = "white"
      ),
      panel.background = element_blank(),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      panel.border = element_rect(
        colour = "black",
        fill = NA,
        size = 1
      ),
      axis.title = element_text(size = rel(0.75)),
      axis.text = element_text(size = rel(0.75)),
      strip.text = element_text(size = rel(0.75)),
      legend.text = element_text(size = rel(0.75)),
      legend.title = element_text(size = rel(0.75))
    )
}

# Set the default theme
theme_set(theme_custom())
```

This R Markdown (Rmd) file contains replication material to reproduce the results reported in Schulte-Cloos & Leininger 'Electoral Mobilization, Political Disaffection, and the Rise of the Radical Right', Party Politics, doi: 10.1177/1354068820985186. 

*Note*: We rely on the [R package management tool `pacman`](). Please run `install.packages("pacman")` to install the package from CRAN. The command `pacman::p_load()` will then import all specified packages and install them first in case they are currently not installed on your machine.
  

# Load raw data

We load the raw data which contains electoral returns of the German populist radical right party AfD and turnout levels on the level of municipalities. The following table shows the first six entries of the dataset. 

```{r load-data}

b17e19 <- read_csv("data/afd_mobildisaffect.csv")

kable(head(b17e19 %>%
  arrange(municipality))) %>%
  kableExtra::kable_styling(bootstrap_options = c("hover", "condensed")) %>%
  scroll_box(width = "100%")
```

# Generate variables

Next, we generate the main variables of interest for our study. 

  1) a binary variable measuring *turnout surges*
  2) an index variable ranging from 0-4 measuring *pre-existing levels of political disaffection*

## Turnout surge variable 

The first central independent variable is 'turnout surge', a binary variable measuring whether turnout in a given municipality increased substantively with respect to the average growth of turnout among all municipalities that fall under the geographic scope of a party branch of the populist right AfD.


```{r generate binary-treatment-variable}

b17e19 <- b17e19 %>%
  group_by(KreisverbandAFD, year) %>%
  mutate(kreisweights = eligible / sum(eligible)) %>%
  # deviation from mean local party branch turnout difference
  mutate(turnout_diff2_dev = turnout_diff2 - weighted.mean(turnout_diff2, kreisweights)) %>%
  # mean and sd local party branch turnout difference
  mutate(
    localbranch_mean = weighted.mean(turnout_diff2, kreisweights),
    localbranch_sd = sqrt(sum(kreisweights * (turnout_diff2 - localbranch_mean)^2))
  ) %>%
  # create binary indicator for turnout surge
  mutate(
    treated = case_when(
      turnout_diff2 > (localbranch_mean + 0.5 * localbranch_sd) ~ 1,
      TRUE ~ 0
    )
  ) %>%
  ungroup() %>%
  # create eligweights (overall sample)
  mutate(eligweights = eligible / sum(eligible))
```


## Political Disaffection Index

The second central variable of interest is an index variable measuring *pre-existing levels of political disaffection*. This index measures levels of political disaffection by classifying municipalities according to their rank in the empirical distribution of observations within each federal state. We rely on state-specific quintiles for the classification. The resulting political disaffection index ranges from 0 (low level of political disaffection) to 4 (high level of political disaffection). If a municipality, during an election prior to the existence of the AfD, belonged to the 20 percent of municipalities with the smallest share of invalid voting and the lowest level of abstention among all municipalities within the same state, the index takes the value 0. If a municipality, in contrast, belongs to the 80 percent of municipalities with the highest share of invalid voting and the greatest level of abstention among all municipalities within the same state, the index takes the value 4.

```{r create-pre-afd-disaffection-variable}

# quintiles of pre-afd invalid voting share
b17e19 <- fuzzyjoin::fuzzy_left_join(
  b17e19,
  b17e19 %>%
    group_by(election_type, state) %>%
    group_modify(~ quantile(.x$pre_afd_invalid_share,
      probs = seq(0, 1, .2),
      na.rm = T
    ) %>%
      tibble::enframe()) %>%
    rename(lower_cut = value) %>%
    group_by(election_type, state) %>%
    mutate(name = as.numeric(str_remove(name, "%"))) %>%
    arrange(name) %>%
    mutate(disaffection_invalid = dplyr::row_number() - 1) %>%
    arrange(disaffection_invalid) %>%
    mutate(upper_cut = dplyr::lead(lower_cut)),
  by = c(
    "election_type" = "election_type",
    "state" = "state",
    "pre_afd_invalid_share" = "lower_cut",
    "pre_afd_invalid_share" = "upper_cut"
  ),
  match_fun = list(`==`, `==`, `>=`, `<`)
) %>%
  select(-c(election_type.y, upper_cut, lower_cut, name, state.y)) %>%
  rename(
    election_type = election_type.x,
    state = state.x
  )


# quintiles of pre-afd abstention rates
b17e19 <- fuzzyjoin::fuzzy_left_join(
  b17e19,
  b17e19 %>%
    group_by(election_type, state) %>%
    group_modify(~ quantile(.x$pre_afd_turnout,
      probs = seq(0, 1, .2),
      na.rm = T
    ) %>%
      tibble::enframe()) %>%
    rename(lower_cut = value) %>%
    group_by(election_type, state) %>%
    mutate(name = as.numeric(str_remove(name, "%"))) %>%
    arrange(desc(name)) %>%
    mutate(disaffection_turnout = dplyr::row_number() - 2) %>%
    arrange(desc(disaffection_turnout)) %>%
    mutate(upper_cut = dplyr::lead(lower_cut)),
  by = c(
    "election_type" = "election_type",
    "state" = "state",
    "pre_afd_turnout" = "lower_cut",
    "pre_afd_turnout" = "upper_cut"
  ),
  match_fun = list(`==`, `==`, `>=`, `<`)
) %>%
  select(-c(election_type.y, upper_cut, lower_cut, name, state.y)) %>%
  rename(
    election_type = election_type.x,
    state = state.x
  )


# create disaffection index
b17e19 <- b17e19 %>%
  group_by(election_type) %>%
  mutate(disaffection = (disaffection_invalid + disaffection_turnout) / 2)
```


```{r b17e19-long}

# create a long dataset
b17e19_long <- b17e19 %>%
  select(
    municipality, state, ags, election_type,
    afd_share, afd_share_lag2, turnout, turnout_lag2, year
  ) %>%
  pivot_longer(
    cols = c(afd_share_lag2, afd_share, turnout, turnout_lag2),
    values_to = "variable",
    names_to = "type"
  ) %>%
  ungroup() %>%
  mutate(
    year = case_when(
      (election_type == "EP" & str_detect(type, "lag2")) ~ 2014,
      (election_type == "National" & str_detect(type, "lag2")) ~ 2013,
      TRUE ~ year
    ),
    type = str_remove(type, "_lag2")
  ) %>%
  pivot_wider(
    id_cols = c(municipality, state, ags, election_type, year),
    values_from = "variable",
    names_from = "type"
  )
```


```{r density-by-states-turnout, fig.showtext=T}

density_pre_turnout_national <- ggplot(
  data = b17e19 %>%
    filter(election_type == "National"),
  aes(x = pre_afd_turnout)
) +
  geom_density() +
  facet_wrap(~state,
    ncol = 4
  ) +
  labs(
    x = "",
    y = "",
    title = "National Election (2009)"
  )


density_pre_turnout_ep <- ggplot(
  data = b17e19 %>%
    filter(election_type == "EP"),
  aes(x = pre_afd_turnout)
) +
  geom_density() +
  facet_wrap(~state,
    ncol = 4
  ) +
  labs(
    x = "",
    y = "",
    title = "EP Elections (2009)"
  )


# combined plot
density_pre_turnout <- density_pre_turnout_national + density_pre_turnout_ep

ggsave(density_pre_turnout,
  file = "figs/pre_turnout.png",
  width = 16,
  height = 8,
  dpi = 850
)
```

Figure \@ref(fig:pre-turnout-figure), corresponding to **Figure A2** in the Online Appendix, and Figure \@ref(fig:pre-invalid-share-figure), corresponding to **Figure A3** in the Online Appendix, show the density distribution of turnout and the share of invalid votes cast in the national election of 2009 and the European elections of 2009, respectively. Both variables display remarkable variation in their empirical distributions across states and election types. To account for this variation and the non-normal empirical distribution of the variables, we rely on the construction of an index as described above.


```{r pre-turnout-figure, fig.cap="Density distribution of turnout levels prior to the existence of the AfD across federal states.", fig.align="center", out.width="100%"}

knitr::include_graphics("figs/pre_turnout.png")
```


```{r density-by-states-invalid_share, fig.showtext=T}

density_pre_invalid_share_national <- ggplot(
  data = b17e19 %>%
    filter(election_type == "National"),
  aes(x = pre_afd_invalid_share)
) +
  geom_density() +
  facet_wrap(~state,
    ncol = 4
  ) +
  labs(
    x = "",
    y = "",
    title = "National Election (2009)"
  )


density_pre_invalid_share_ep <- ggplot(
  data = b17e19 %>%
    filter(election_type == "EP"),
  aes(x = pre_afd_invalid_share)
) +
  geom_density() +
  facet_wrap(~state) +
  labs(
    x = "",
    y = "",
    title = "EP Elections (2009)"
  )


# combined plot
density_pre_invalid_share <- density_pre_invalid_share_national + density_pre_invalid_share_ep

ggsave(density_pre_invalid_share,
  file = "figs/pre_invalid_share.png",
  width = 16,
  height = 8,
  dpi = 850
)
```


```{r pre-invalid-share-figure, fig.cap="Density distribution of invalid vote shares prior to the existence of the AfD across federal states.", fig.align="center", out.width="100%"}

knitr::include_graphics("figs/pre_invalid_share.png")
```


# Analysis

In the following, we provide the code for all analyses that we present in the article. 

## Bivariate assosciation between turnout and the success of the AfD

The following scatterplot shows the assosciation between rising electoral participation levels and the success of the AfD, corresponding to **Figure 1** in the article. 

```{r scatter-assosciation, fig.showtext=T, fig.retina=3}

bivariate_scatter_data <- b17e19_long %>%
  mutate(election_type = forcats::fct_relevel(election_type,
    levels = c(
      "National",
      "EP"
    )
  )) %>%
  ungroup() %>%
  mutate(
    net_turnout = residuals(lm(turnout ~ as.factor(state),
      data = b17e19_long
    )),
    net_afd_share = residuals(lm(afd_share ~ as.factor(state),
      data = b17e19_long
    ))
  )


bivariate_scatter <-
  ggplot(
    data = bivariate_scatter_data,
    aes(
      x = net_turnout,
      y = net_afd_share
    )
  ) +
  geom_point(
    alpha = 0.2,
    color = "grey50",
    shape = 1
  ) +
  geom_smooth(
    method = "lm",
    color = "black"
  ) +
  labs(
    x = "Turnout",
    y = "Populist Radical Right Vote Share"
  ) +
  facet_wrap(~election_type,
    scales = "fixed"
  )

showtext_auto()
ggsave(bivariate_scatter,
  file = "figs/turnout_afd_scatter.png",
  dpi = 300,
  width = 12,
  height = 5
)
```


```{r scatter-plot-include, fig.cap='Bivariate relationship between turnout and the success of the AfD after residualizing both variables with respect to state-fixed effects.', fig.align="center", out.width="70%"}

knitr::include_graphics("figs/turnout_afd_scatter.png")
```


## Turnout surges within AfD party branches 

Figure \@ref(fig:map) visualizes the variation in turnout growth relative to the average turnout growth among all municipalities falling under a given populist right party branch for the example of the 'AfD Kreisverband Miesbach', corresponding to **Figure 2** in the article. 

Panel C of Figure \@ref(fig:map) highlights that the local party branches of the AfD are small geographic entities, while the respective subordinated municipalities are even smaller. This is reflected in the number of eligible voters: the median municipality has `r median(b17e19$eligible, na.rm = T)` eligible voters.

```{r map, fig.cap="Municipal-level deviation from average turnout growth within the geographical scope of the party branch Miesbach during the EP elections of 2019. The strength of the shading in Panel A indicates the deviation of a municipality from the average change in turnout. The municipality Irschenberg experienced a large turnout surge: the growth in electoral participation was 16.19 percentage points higher than the average growth among all municipalities within the local AfD party branch.", fig.align="center", out.width="70%", fig.pos="tb"}


knitr::include_graphics("figs/turnout_surge_mb_irschenberg.png")
```

The following table displays the related data in tabular format. To account for the differences in the size of the electorates across municipalities, we calculate a municipality's turnout change with respect to the *weighted* average change of all municipalities under the geographical scope of the AfD party branch. Weights are calculated as the share of eligible voters in a municipality among all eligible voters in the party branch Miesbach.

```{r irschenberg-table}

miesbach19 <- b17e19 %>%
  filter(year == 2019 & KreisverbandAFD == "Miesbach") %>%
  ungroup() %>%
  select(turnout, eligible, turnout_diff2, municipality) %>%
  mutate(kreisweights = eligible / sum(eligible)) %>%
  mutate(
    meanturnout = weighted.mean(turnout, kreisweights),
    meanturnoutdiff = weighted.mean(turnout_diff2, kreisweights),
    turnoutdiff_dev = turnout_diff2 - meanturnoutdiff
  ) %>%
  select(municipality, turnoutdiff_dev) %>%
  arrange(desc(turnoutdiff_dev))


kable(miesbach19,
  col.names = c("Municipality", "Deviation from Avg. Turnout Growth"),
  digits = 2
) %>%
  kableExtra::kable_styling(bootstrap_options = c("hover"))

```

## Nested data with the different models 

We create a nested dataframe to run the models over the different subsets of interest, i.e., national elections, EP elections, national elections (West Germany), EP elections (West Germany), national elections (East Germany), EP elections (East Germany).

```{r datasets-different-models}

b17e19_data_models <-
  # create a dataframe with the different datasets used in the six model types
  dplyr::bind_rows(
    b17e19 %>%
      select(-c(
        eligweights, kreisweights, localbranch_mean,
        localbranch_sd,
        turnout_lag2, afd_share_lag2,
        `Kreis / Landkreis`
      )) %>%
      group_by(election_type) %>%
      nest() %>%
      mutate(modeltype = election_type),
    # east/ west and election type
    b17e19 %>%
      select(-c(
        eligweights, kreisweights, localbranch_mean,
        localbranch_sd,
        turnout_lag2, afd_share_lag2,
        `Kreis / Landkreis`
      )) %>%
      group_by(election_type, east) %>%
      nest() %>%
      # create distinct group identifier over which to map
      mutate(modeltype = paste0(election_type, "_", east)) %>%
      ungroup() %>%
      select(-east)
  ) %>%
  as_tibble() %>%
  mutate(modeltype = forcats::fct_relevel(modeltype,
    levels = c(
      "National",
      "EP",
      "National_0",
      "EP_0",
      "National_1",
      "EP_1"
    )
  )) %>%
  arrange(modeltype) %>%
  mutate(data = map(
    data,
    ~ mutate(.,
      elig_weights = eligible / sum(eligible, na.rm = T),
      N = n()
    )
  ))
```

We specify the linear model functions that we will later estimate on the nested dataframe using `purrr`. 

```{r model-functions}

# lm function
fit_model <- function(data,
                      election_type) {
  if (election_type == "National") {
    lm(afd_share_diff2 ~ treated + afdcandidate + as.factor(state),
      weights = elig_weights,
      data = data
    )
  } else {
    lm(afd_share_diff2 ~ treated + as.factor(state),
      weights = elig_weights,
      data = data
    )
  }
}


# lm function interaction
fit_model_interact <- function(data,
                               election_type) {
  if (election_type == "National") {
    lm(afd_share_diff2 ~ treated * disaffection + afdcandidate + as.factor(state),
      weights = elig_weights,
      data = data
    )
  } else {
    lm(afd_share_diff2 ~ treated * disaffection + as.factor(state),
      weights = elig_weights,
      data = data
    )
  }
}
```

We compile the bootstrap distribution of each regression coefficient by treating the observed municipalities as the population from which we re-sample 5000 times. The 5th and 95th percentiles of the empirical distribution form the limits for the 95% bootstrap percentile confidence intervals. 

```{r bootstrap-models, eval=F}

source("boot.R")
```

This process is computationally intense, so we store the estimated bootstrap percentile confidence intervals in an external csv-file, which we load to save computational time. 

```{r read-bootstrapped-cis}

booted_cis <- read_csv(file = "data/booted_cis.csv") %>%
  nest(data = c(-modeltype)) %>%
  mutate(ci.int = map(
    data,
    ~ tibble(
      paste0(.x %>% select(term) %>% pull()),
      paste0(
        "[",
        sprintf("%.2f", .x %>% pull(conf.low)),
        "; ",
        sprintf("%.2f", .x %>% pull(conf.high)),
        "]"
      )
    ) %>% deframe()
  ))
```

## Model estimation 

We estimate the simple linear model function (`model`) and linear interaction model function (`model_interact`) on our nested dataframe containing the six different subsets of our data. 

```{r reestimate-lm-models-once}

boot_models <-
  b17e19_data_models %>%
  mutate(
    model = map2(
      data,
      election_type,
      ~ fit_model(
        data = .x,
        election_type = .y
      )
    ),
    coefs_model = map(model, tidy),
    stats_model = map(model, glance)
  ) %>%
  # interaction model
  mutate(
    model_interact = map2(
      data,
      election_type,
      ~ fit_model_interact(
        data = .x,
        election_type = .y
      )
    ),
    coefs_model_interact = map(model_interact, tidy),
    stats_model_interact = map(model_interact, glance)
  )



names(boot_models$model) <- boot_models$election_type
names(boot_models$model_interact) <- boot_models$election_type
```


## Average effect of turnout surges on the electoral success of the populist right AfD 

Table \@ref(tab:main-tab) shows the average effect of turnout surges on the $\Delta$ success of the populist radical right AfD while including state fixed-effects in all models. It corresponds to **Table 1** in the article. 

```{r main-tab}

gm <- gof_map %>%
  mutate(omit = case_when(
    raw == "r.squared" | raw == "nobs" ~ FALSE,
    TRUE ~ TRUE
  )) %>%
  arrange(desc(raw))

cm <- c(
  "treated" = "Turnout Surge",
  "(Intercept)" = "Intercept"
)

rows <- tribble(
  ~term, ~National, ~EP, ~National, ~EP, ~National, ~EP,
  "State Fixed Effects",
  "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"
)

attr(rows, "position") <- c(5)


main_tab <-
  msummary(boot_models$model,
    coef_map = cm,
    gof_map = gm,
    statistic_override = booted_cis$ci.int,
    add_rows = rows,
    title = "Effect of turnout surges on the electoral success of the populist right AfD",
    output = "kableExtra"
  )


main_tab %>%
  # column labels
  add_header_above(c(" " = 1, "Full Model" = 2, "West" = 2, "East" = 2)) %>%
  # footnote
  add_footnote("All models report 95% confidence intervals based on 5000 bootstrap resamples stratified by states.",
    notation = "none"
  ) %>%
  kable_styling(bootstrap_options = c("hover"))
```

## The effect of turnout surges conditional on baseline levels of political disaffection

We present the results of the effect of turnout surges conditional on a municipality's *pre-existing political disaffection* (interaction model) in graphical form (see Figure \@ref(fig:interaction-plot-combined), corresponding to **Figure 3** in the article) and in a regression table (see Table \@ref(tab:interaction-tab), corresponding to **Table A5** in the Online Appendix).

```{r interaction-plots, include=FALSE, fig.showtext=T, fig.retina=3}

showtext_auto()

# character modeltype for the plot titles
boot_models <- boot_models %>%
  mutate(modeltype_chr = case_when(
    modeltype == "National" ~ "National Election",
    modeltype == "EP" ~ "EP Election",
    modeltype == "National_0" ~ "National Election (West)",
    modeltype == "National_1" ~ "National Election (East)",
    modeltype == "EP_0" ~ "EP Election (West)",
    modeltype == "EP_1" ~ "EP Election (East)",
    TRUE ~ as.character(modeltype)
  ))


# ggemmeans keeps the factor variables on their averages for the prediction
m_interact_eemeans <- map(
  boot_models$model_interact,
  ~ ggemmeans(.,
    terms = c(
      "disaffection",
      "treated"
    )
  ) %>%
    as_tibble() %>%
    rename(
      treated = group,
      disaffection = x
    )
)




interact_plots <- map2(
  m_interact_eemeans,
  boot_models$modeltype_chr,
  ~ ggplot(
    data = .x,
    aes(
      x = disaffection,
      y = predicted,
      ymin = conf.low,
      ymax = conf.high,
      shape = treated
    )
  ) +
    geom_pointrange(position = position_dodge(width = 0.05)) +
    scale_shape_discrete(name = "Turnout Surge") +
    labs(
      x = "Level of political disaffection",
      y = "Predicted Delta AfD Share",
      colour = "Turnout Surge",
      title = "Effect of turnout surges on AfD success",
      subtitle = .y
    ) +
    theme(legend.position = "bottom")
)


# save all plots 
walk2(
  paste0("figs/m_interact", boot_models$modeltype, ".png"),
  interact_plots,
  ~ ggsave(
    filename = .x,
    plot = .y,
    width = 8,
    height = 5,
    dpi = 300
  )
)


## combine the plots of National and EP elections (with a single title and shared legend/axes)
combined_plot_data <- bind_rows(
  m_interact_eemeans[1] %>%
    flatten() %>%
    as_tibble() %>%
    mutate(election_type = "National Election"),
  m_interact_eemeans[2] %>%
    flatten() %>%
    as_tibble() %>%
    mutate(election_type = "EP Election")
) %>%
  mutate(election_type = forcats::fct_relevel(election_type,
    levels = c(
      "National Election",
      "EP Election"
    )
  ))



combined_plot <- ggplot(
  combined_plot_data,
  aes(
    x = disaffection,
    y = predicted,
    ymin = conf.low,
    ymax = conf.high,
    shape = treated
  )
) +
  geom_pointrange() +
  scale_shape_discrete(name = "Turnout Surge") +
  labs(
    x = "Level of political disaffection",
    y = "Predicted Delta AfD Share",
    colour = "Turnout Surge",
    title = "Effect of turnout surges on AfD success"
  ) +
  facet_wrap(~election_type,
    scales = "free_y"
  ) +
  theme(legend.position = "bottom")


ggsave("figs/combined_predicted_interact.png",
  plot = combined_plot,
  width = 14,
  height = 7,
  dpi = 300
)
```


```{r interaction-plot-combined, fig.cap="The effect of turnout surges on the success of the populist right: average changes in AfD vote share in municipalities with and without turnout surges along different baseline levels of political disaffection", out.width="70%", fig.align="center", fig.pos="tb"}

knitr::include_graphics("./figs/combined_predicted_interact.png")
```

Table \@ref(tab:interaction-tab) reports the effect of turnout on the success of the populist radical right conditional on different baseline levels of political disaffection within a given locality. Column 1 (national elections) and column 2 (EP elections) refer to the predicted average effects shown in Figure \@ref(fig:interaction-plot-combined). The full table is reported in **Table A5** in the Online Appendix.

```{r interaction-tab}

booted_cis_interact <- read_csv(file = "data/booted_cis_interact.csv") %>%
  nest(data = c(-modeltype)) %>%
  mutate(ci.int = map(
    data,
    ~ tibble(
      paste0(.x %>% select(term) %>% pull()),
      paste0(
        "[",
        sprintf("%.2f", .x %>% pull(conf.low)),
        "; ",
        sprintf("%.2f", .x %>% pull(conf.high)),
        "]"
      )
    ) %>% deframe()
  ))


gm <- gof_map %>%
  mutate(omit = case_when(
    raw == "r.squared" | raw == "nobs" ~ FALSE,
    TRUE ~ TRUE
  )) %>%
  arrange(desc(raw))

cm <- c(
  "treated" = "Turnout Surge",
  "disaffection" = "Disaffection",
  "treated:disaffection" = "Turnout Surge x Disaffection",
  "(Intercept)" = "Intercept"
)


rows <- tribble(
  ~term, ~National, ~EP, ~National, ~EP, ~National, ~EP,
  "State Fixed Effects",
  "Yes", "Yes", "Yes", "Yes", "Yes", "Yes"
)

attr(rows, "position") <- c(9)


interact_tab <-
  msummary(boot_models$model_interact,
    coef_map = cm,
    gof_map = gm,
    statistic_override = booted_cis_interact$ci.int,
    add_rows = rows,
    title = "Effect of turnout surges on the electoral succes of the populist right AfD conditional on pre-existing political disaffection",
    output = "kableExtra"
  )


interact_tab %>%
  # column labels
  add_header_above(c(" " = 1, "Full Model" = 2, "West" = 2, "East" = 2)) %>%
  # footnote
  add_footnote("All models report 95% confidence intervals based on 5000 bootstrap resamples stratified by states.",
    notation = "none"
  ) %>%
  kableExtra::kable_styling(bootstrap_options = c("hover"))
```

# Descriptive statistics

## Municipalities per state and year

Table \@ref(tab:tab-obsperstate) shows the number of different municipalities across states and years. As Germany is a federally organized state leaving questions related to the administrative and territorial division up to the authority of the states (*Länder*), the number of municipalities per state varies considerably. Accordingly, all models rely on population based weights to account for the different sizes of municipalities across states. These descriptives can be found in **Table A1** in the Online Appendix.

```{r tab-obsperstate}

obsperstate <- b17e19_long %>%
  group_by(state, year) %>%
  dplyr::summarize(nmun = n()) %>%
  tidyr::pivot_wider(
    id_cols = state,
    names_from = year,
    values_from = nmun
  ) %>%
  ungroup() %>%
  mutate(state = str_to_title(state))


kable(obsperstate,
  col.names = c(
    "State",
    "2013",
    "2014",
    "2017",
    "2019"
  ),
  caption = "Municipality observations per state and year"
) %>%
  kable_styling(bootstrap_options = c("hover"))
```

## Average difference in populist right vote share and turnout across states

Table \@ref(tab:average-afd-and-turnout-diff-per-state) shows the average growth in the vote share of the populist right AfD as well as the average growth in popular electoral participation across states. It corresponds to **Table A1** in the Online Appendix. While the AfD substantively increased its vote share in almost all German regions between the national election of 2013 and the national election of 2017 (see column 1 in Table \@ref(tab:average-afd-and-turnout-diff-per-state)), in the 2019 EP elections, the party's largest average gains are concentrated in the Eastern German regions (Brandenburg, Mecklenburg-Vorpommern, Sachsen, Sachsen-Anhalt, Thüringen), however, with large standard deviations as seen in the error bars of Figure \@ref(fig:afd-growth-by-state), which corresponds to **Figure A1** in the Online Appendix.

```{r average-afd-and-turnout-diff-per-state}

turnout_afd_bystate <- b17e19 %>%
  group_by(state, year) %>%
  dplyr::summarize(
    `Mean Delta AfD Share` = weighted.mean(afd_share_diff2,
      eligweights,
      na.rm = T
    ),
    `Mean Delta Turnout` = weighted.mean(turnout_diff2,
      eligweights,
      na.rm = T
    )
  ) %>%
  tidyr::pivot_wider(
    id_cols = state,
    names_from = year,
    values_from = c(`Mean Delta AfD Share`, `Mean Delta Turnout`)
  ) %>%
  ungroup() %>%
  mutate(state = str_to_title(state))



kable(turnout_afd_bystate,
  col.names = c(
    "State",
    "2017",
    "2019",
    "2017",
    "2019"
  ),
  digits = 2,
  caption = "Mean difference in AfD vote share and turnout across states (weighted by municipality size)"
) %>%
  add_header_above(c(" ",
    "Delta AfD vote" = 2,
    "Delta turnout" = 2
  )) %>%
  kableExtra::add_footnote("Note: Entries present weighted means of all observations.", notation = "none") %>%
  kable_styling(bootstrap_options = c("hover"))
```


```{r graph-afd-states, fig.retina=3}

showtext_auto()

afd_states <- b17e19 %>%
  group_by(year, state, east) %>%
  mutate(east = case_when(
    state == "Berlin" ~ 0,
    TRUE ~ east
  )) %>%
  dplyr::summarise(
    mean_afd = weighted.mean(afd_share_diff2,
      eligweights,
      na.rm = T
    ),
    sd_afd = sd(afd_share_diff2,
      na.rm = T
    )
  ) %>%
  ggplot(aes(
    x = reorder(
      forcats::fct_rev(state),
      -east
    ),
    y = mean_afd,
    color = state
  )) +
  geom_point(size = 1) +
  geom_pointrange(aes(
    color = state,
    x = state,
    y = mean_afd,
    ymin = mean_afd - (sd_afd),
    ymax = mean_afd + (sd_afd)
  )) +
  geom_hline(yintercept = 0, linetype = "dotdash") +
  scale_colour_discrete_divergingx() +
  labs(
    x = "",
    y = "Average Change in AfD Share"
  ) +
  theme(legend.position = "none") +
  facet_wrap(facets = "year") +
  coord_flip()


ggsave(afd_states,
  file = "figs/afd_states.png",
  width = 12,
  height = 7,
  dpi = 300
)
```

```{r afd-growth-by-state, out.width="100%", fig.cap="Average growth in populist right vote share across German states", fig.align="center"}

knitr::include_graphics(path = "figs/afd_states.png")
```

## Locally disaggregated results for the largest cities

Table \@ref(tab:citydistricts) displays the cities included in the analysis along with the number of city districts for which we have locally disaggregated electoral data in our panel dataset. It corresponds to **Table A3** in the Online Appendix.

```{r citydistricts}

citydistricts <- b17e19_long %>%
  filter(str_length(ags) == 11) %>%
  ungroup() %>%
  mutate(city_ags = str_sub(ags, 1, 8)) %>%
  group_by(city_ags, year) %>%
  dplyr::summarize(
    municipality = first(municipality),
    nmun = n()
  ) %>%
  mutate(municipality = str_remove_all(municipality, "[0-9]")) %>%
  mutate(municipality = str_to_title(municipality)) %>%
  tidyr::pivot_wider(
    id_cols = c("municipality"),
    names_from = year, values_from = nmun
  )


kable(citydistricts,
  col.names = c("City", "2013", "2014", "2017", "2019"),
  digits = 2,
  caption = "Number of city districts per city"
) %>%
  kable_styling(bootstrap_options = c("hover"))
```


## Over-time variation in turnout growth among municipalities with and without a turnout surge in 2017 and 2019

To further illustrate the quasi-random nature of turnout surges, Table \@ref(tab:variation-tab), which corresponds to **Table A4** in the Online Appendix, shows the average deviations from the mean turnout growth or decline in all municipalities falling under the geographic scope of a local party branch within municipalities that experienced a turnout surge in 2017 and 2019, respectively, and those that did not experience such a turnout surge. Those municipalities that experienced a turnout surge in 2017, or 2019, respectively, do not have a history of experiencing turnout surges in prior elections. Thus, our measure of turnout surges relative to the mean increases in turnout among all municipalities of the same local party branch seems to capture quasi-random variation in increased electoral mobilization.  


```{r variation-tab}

turnout_time <-
  # long turnout data
  b17e19 %>%
  select(
    municipality, state, ags, election_type,
    turnout, turnout_lag2, pre_afd_turnout, year, treated, KreisverbandAFD
  ) %>%
  pivot_longer(
    cols = c(turnout, turnout_lag2, pre_afd_turnout),
    values_to = "variable",
    names_to = "type"
  ) %>%
  ungroup() %>%
  mutate(
    year = case_when(
      (election_type == "EP" & str_detect(type, "lag2")) ~ 2014,
      (election_type == "National" & str_detect(type, "lag2")) ~ 2013,
      (election_type == "National" & str_detect(type, "pre_afd_turnout")) ~ 2009,
      (election_type == "EP" & str_detect(type, "pre_afd_turnout")) ~ 2009,
      TRUE ~ year
    ),
    type = "turnout"
  ) %>%
  filter(year < 2017) %>%
  rename(turnout = variable) %>%
  select(-type) %>%
  group_by(KreisverbandAFD, election_type, ags) %>%
  arrange(year) %>%
  mutate(turnout_diff2 = turnout - dplyr::lag(turnout)) %>%
  ungroup() %>%
  group_by(KreisverbandAFD, election_type) %>%
  mutate(
    mean_turnout_diff2 = mean(turnout_diff2, na.rm = T),
    turnout_diff2_dev = turnout_diff2 - mean_turnout_diff2
  ) %>%
  # arrange for kable
  group_by(treated, election_type) %>%
  summarise(turnout_diff2_dev = mean(turnout_diff2_dev, na.rm = T)) %>%
  filter(!is.na(turnout_diff2_dev)) %>%
  pivot_wider(
    id_cols = "treated",
    names_from = "election_type",
    values_from = "turnout_diff2_dev"
  ) %>%
  rename(
    "Turnout Surge\n2017/2019" = treated,
    "Dev. from party branch turnout growth during the EP Elections (2014)" = EP,
    "Dev. from party branch turnout growth during the National Election (2013)" = National
  )



kable(turnout_time,
  digits = 2,
  caption = "Average deviation from party branch turnout growth among municipalities displaying a turnout surge in 2017/2019",
) %>%
  column_spec(1, width = "1.5cm") %>%
  column_spec(2, width = "6cm") %>%
  column_spec(3, width = "6cm") %>%
  kable_styling(bootstrap_options = c("hover"))
```

# R session info

```{r echo=FALSE}
xfun::session_info()
```
